home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / miscpas.zip / GALEXY.PAS < prev    next >
Pascal/Delphi Source File  |  1984-06-12  |  4KB  |  142 lines
  1. Program GALEXY;
  2.  
  3. {  This program projects a view of our galexy on the IBM PC hi-res graphics }
  4. {  screen.  The view is anamated giving leaving the viewer with the impres- }
  5. {  sion that he is traveling at an incredible speed though the Milky Way.   }
  6.  
  7. {  Writen for Turbo Pascal v2.0.  The 8087 version of Turbo Pascal should   }
  8. {  be used in order to achieve real time updating.                          }
  9.  
  10. {  The program uses the external procedure POINT.INV and CLS.INV.  Both of  }
  11. {  these must be resident on the default disk in order to compile the prgm. }
  12.  
  13. {  Adapted by Jeff Firestone; May 23, 1984.  HAL-PC Pascal SIG.             }
  14. {  Original Source: Mark Dahmke's article in Byte, April 1978, pp. 66-80.   }
  15.  
  16. Const
  17.   Size = 131;  { Number of Stars in Stars.DTA }
  18.   xx   = 639;  {  Screen X resolution   }
  19.   yy   = 199;  {  Screen Y resolution   }
  20.  
  21. VAR
  22.   i, count : integer;
  23.   hp, xl, yl, xo, yo : real;
  24.   cra, cdec, cxy, cdist, dist, ra, dec, vel : real;
  25.   axy, ax, ay, az, xp, yp, zp, nra, newr, ndec, tmp : real;
  26.   KeyBufPointer : Integer;
  27.   F : text;
  28.   fx, fy, fz : array [0..size] of real;
  29.   x1, y1 : array [0..size] of integer;
  30.  
  31.  
  32. Procedure cls; External 'Cls.inv';
  33. Procedure Dot(a,b,c:integer); External 'Point.inv';
  34.  
  35. Procedure InitVars;
  36. begin
  37.  
  38.   dist := -1000;    {  Distance from Earth in light years  }
  39.   ra   := pi;       {  Right ascension in degrees          }
  40.   dec  := 0;        {  Declination in degrees              }
  41.   vel  := 20;       {  Velocity in light years per update  }
  42.  
  43.   hp   := pi / 2;
  44.   xl   := xx / pi;
  45.   yl   := yy / pi;
  46.   xo   := xx;
  47.   yo   := yy / 2;
  48.   KeyBufPointer:= MemW[$0040:$001A];
  49. end;
  50.  
  51.  
  52. Procedure ReadArrays;
  53. begin
  54.   assign(f, 'stars.dat');
  55.   reset(f);
  56.  
  57.   FOR i := 1 TO size do
  58.   begin
  59.     READ(F, cra,cdec,cdist);
  60.  
  61. {  Convert CRA and CDEC to radians  }
  62.     cra   := cra   * 0.261799;
  63.     cdec  := cdec  * 0.01745;
  64.  
  65.     cxy   := cdist * COS(cdec);
  66.     fx[i] := cxy   * COS(cra);
  67.     fy[i] := cxy   * SIN(cra);
  68.     fz[i] := cdist * SIN(cdec);
  69.   end;
  70. end;
  71.  
  72.  
  73. Function KeyWasPressed : Boolean;
  74. begin
  75.   if KeyBufPointer <> MemW[$0040:$001A]
  76.   then
  77.      KeyWasPressed:= True
  78.   Else
  79.      KeyWasPressed:= False;
  80. end;
  81.  
  82.  
  83. Procedure PlotIt;
  84. var
  85.   cosdec, cosra, sinra, sindec : real;
  86. begin
  87.   hires; hirescolor(7);
  88.  
  89.   CosDec := cos(dec);
  90.   CosRa  := cos(ra);
  91.   SinRa  := sin(ra);
  92.   SinDec := sin(dec);
  93.  
  94.   count:= 0;
  95.   repeat
  96.  
  97. {  Advance the distance counter  }
  98.     dist := dist + vel;
  99.  
  100. {  Compute the new location in space from RA, DEC, DIST  }
  101.     axy  := dist * CosDec;
  102.     ax   := axy  * CosRa;
  103.     ay   := axy  * SinRa;
  104.     az   := dist * SinDec;
  105.  
  106. {  Convert the shifted coordinates to celestial coordinates and plot  }
  107.     FOR i := 1 TO size do
  108.     begin
  109.       xp := fx[i] - ax;
  110.       yp := fy[i] - ay;
  111.       zp := fz[i] - az;
  112.  
  113.       nra  := ArcTan(yp / xp);
  114.       newr := SQRT(xp * xp + yp * yp + zp * zp);
  115.       tmp  := zp / newr;
  116.       ndec := ArcTan(tmp / (SQR(1 - (tmp * tmp))));  {  ArcSin function  }
  117.  
  118. {  Test for quadrants messed up by the acrtangent function  }
  119.       IF (xp < 0) THEN nra := nra + hp;
  120.       IF (xp > 0) AND (yp < 0) THEN nra := nra + pi;
  121.  
  122. {  Test for screen limits  }
  123.       IF (nra > pi) THEN nra := nra - pi;
  124.       IF (nra < 0)  THEN nra := nra + pi;
  125.  
  126. {  Scale for screen  }
  127.       x1[i] := round(xo - (nra * xl));
  128.       y1[i] := round((ndec * yl) + yo);
  129.     end;
  130.     cls;
  131.     for i:= 1 to size do plot(x1[i], y1[i], 1);
  132.     count:= count + 1;
  133.   Until (count = 100) or (KeyWasPressed);
  134. end;
  135.  
  136.  
  137. begin
  138.   InitVars;
  139.   ReadArrays;
  140.   PlotIt;
  141. end.
  142.